home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Mac Mania 4
/
MacMania 4.toast
/
/
Demo's
/
Igor Demo Pro
/
Igor 68K NoFPU 3.01 Demo Folder
/
Igor 68K NoFPU 3.01 Demo
/
Igor 68K NoFPU 3.01 Demo.rsrc
/
IGPS_2
< prev
next >
Wrap
Text File
|
1996-04-18
|
10KB
|
506 lines
/IgorSave save def
1000 dict begin
0 setgray 0 setlinecap
1 setlinewidth 0 setlinejoin
1 setmiterlimit [] 0 setdash
/aw 0 def /ah 0 def
/x0 0 def /y0 0 def /x1 0 def /y1 0 def
/rx0 0 def /ry0 0 def /rx1 0 def /ry1 0 def
/tmp0 0 def /tmp1 0 def
/packedRed 0 def /packedGreen 0 def /packedBlue 0 def
/x 0 def /y 0 def /w 0 def /c 0 string def
/rbak 1 def /gbak 1 def /bbak 1 def
/rfor 0 def /gfor 0 def /bfor 0 def
/bdef{bind def}bind def
/ldef{load def}bdef
/xdef{exch def}bdef
/setuserscreendict 22 dict def
setuserscreendict begin
/tempctm matrix def
/temprot matrix def
/tempscale matrix def
/concatprocs{
/proc2 exch cvlit def
/proc1 exch cvlit def
/newproc proc1 length proc2 length add array def
newproc 0 proc1 putinterval
newproc proc1 length proc2 putinterval
newproc cvx
}def
/resmatrix matrix def
/findresolution{
72 0 resmatrix defaultmatrix dtransform
/yres xdef /xres xdef
xres dup mul yres dup mul add sqrt
}def
end
/setuserscreen{
setuserscreendict begin
/spotfunction xdef
/screenangle xdef
/cellsize xdef
/m tempctm currentmatrix def
/rm screenangle temprot rotate def
/sm cellsize dup tempscale scale def
sm rm m m concatmatrix m concatmatrix pop
1 0 m dtransform /y1 xdef /x1 xdef
/veclength x1 dup mul y1 dup mul add sqrt def
/frequency findresolution veclength div def
/newscreenangle y1 x1 atan def
m 2 get m 1 get mul m 0 get m 3 get mul sub 0 gt
{
{ neg } /spotfunction load concatprocs
/spotfunction xdef
} if
frequency newscreenangle /spotfunction load setscreen
end
}def
/setpatterndict 18 dict def
setpatterndict begin
/bitison{
/ybit xdef /xbit xdef
/bytevalue bstring ybit bwidth mul xbit 8 idiv add get def
/mask 1 7 xbit 8 mod sub bitshift def
bytevalue mask and 0 ne
}def
end
/bitpatternspotfunction{
setpatterndict begin
/y xdef /x xdef
/xindex x 1 add 2 div bpside mul cvi def
/yindex y 1 add 2 div bpside mul cvi def
xindex yindex bitison
{ /onbits onbits 1 add def 1 }
{ /offbits offbits 1 add def 0 }
ifelse
end
}def
/setpattern{
setpatterndict begin
/cellsz xdef
/angle xdef
/bwidth xdef
/bpside xdef
/bstring xdef
/onbits 0 def /offbits 0 def
cellsz angle /bitpatternspotfunction load setuserscreen
{} settransfer
offbits offbits onbits add div setgray
end
}def
/FillPattern{ % patternstring --
/pat xdef
gsave
pat 8 1 0 72 300 32 div div setpattern
fill
grestore
}def
/UseBack{ rbak gbak bbak setrgbcolor }bdef
/UseFore{ rfor gfor bfor setrgbcolor }bdef
/SetBack {/bbak xdef /gbak xdef /rbak xdef }bdef
/SetFore {/bfor xdef /gfor xdef /rfor xdef }bdef
/ps {setlinewidth} bdef
/clw {currentlinewidth} bdef
/sd {0 setdash} bdef
/mstroke {0 clw eq {newpath}{stroke} ifelse} bdef
/_R{ .5 sub round .5 add}bdef
/allign { transform _R exch _R exch itransform }bdef
/L {allign lineto} bdef
/M {allign moveto} bdef
/addto { dup load exec 3 -1 roll add store }bdef
/MacLine{ % xto yto xfrom yfrom MacLine --
newpath % only handles horizontal or vertical lines
/y0 xdef /x0 xdef /y1 xdef /x1 xdef
x1 x0 sub abs
y1 y0 sub abs gt
{clw x1 x0 gt {/x1}{/x0}ifelse addto clw 2 div dup /y0 addto /y1 addto}
{clw y1 y0 gt {/y1}{/y0}ifelse addto clw 2 div dup /x0 addto /x1 addto}
ifelse
x0 y0 M
x1 y1 L
mstroke
}bdef
/FillPath{ % graylevel FillPath -- fills current path and leaves path alive
gsave
dup 1 exch sub % glev 1-glev
rbak 2 index mul rfor 2 index mul add
gbak 3 index mul gfor 3 index mul add
bbak 4 index mul bfor 4 index mul add
setrgbcolor
pop pop
fill
grestore
}bdef
/StrokePath{ % linejoin StrokePath -- strokes current path and leaves path alive
gsave
setlinejoin
mstroke
grestore
}bdef
/RectPath{ % x0 y0 x1 y1 RectPath -- sets current path to a rectange
/y1 xdef /x1 xdef /y0 xdef /x0 xdef
newpath
x0 y0 M
x1 y0 L
x1 y1 L
x0 y1 L
closepath
}bdef
/PaintRect{ % x0 y0 x1 y1 graylevel PaintRect --
gsave
5 1 roll
RectPath
FillPath
grestore
}bdef
% **** begin image stuff *****
% The following are used for images. This has to be kept
% in synch with corresponding code in ImageDisp.c.In particular
% the expansion factor, 8, has to be in synch.
% packedcolor is (red*256+green)*256+blue
/SetPackedColor{ % packedcolor SetPackedColor --
dup 256 mod /tmp0 xdef % extract blue
256 idiv
dup 256 mod /tmp1 xdef % extract green
256 idiv % extract red
255 div /packedRed xdef
tmp1 255 div /packedGreen xdef
tmp0 255 div /packedBlue xdef
}bdef
/IR_FillRect{
gsave
newpath
rx0 ry0 M
rx1 ry0 L
rx1 ry1 L
rx0 ry1 L
closepath
packedRed packedGreen packedBlue setrgbcolor
fill
grestore
}bdef
/NewRectImageLine{ % x0 y0 x1 y1 packedcolor NewRectImageLine --
SetPackedColor
/ry1 xdef /rx1 xdef /ry0 xdef /rx0 xdef % remember starting rectange for following calls
IR_FillRect
}bdef
/rx{ % xdist rx --
8 div
dup 0 lt
{ rx0 /rx1 xdef rx1 add /rx0 xdef } % neg delta steps left
{ rx1 /rx0 xdef rx0 add /rx1 xdef }
ifelse
IR_FillRect
}bdef
/ry{ % ydist rr --
8 div
dup 0 lt
{ ry1 /ry0 xdef ry0 exch sub /ry1 xdef } % neg delta steps down
{ ry0 /ry1 xdef ry1 exch sub /ry0 xdef }
ifelse
IR_FillRect
}bdef
/cx{ % xdist packedcolor cx --
SetPackedColor
rx
}bdef
/cy{ % ydist packedcolor cx --
SetPackedColor
ry
}bdef
% **** end image stuff *****
/EraseRect{ % x0 y0 x1 y1 EraseRect -- fills rect with background color
gsave
RectPath
UseBack fill
grestore
}bdef
/FrameRect{ % x0 y0 x1 y1 FrameRect --
RectPath
mstroke
}bdef
/FrameMacRect{ % x0 y0 x1 y1 FrameMacRect -- Mac-like version
RectPath
mstroke
}bdef
/ellipse{
/savematrix matrix currentmatrix def
translate scale 0 0 1 0 360 arc
savematrix setmatrix
}bdef
/OvalPath{ % x0 y0 x1 y1 OvalPath -- sets current path to an oval inside rectange
/y1 xdef /x1 xdef /y0 xdef /x0 xdef
newpath
x0 x1 sub abs 2 div y0 y1 sub abs 2 div x0 x1 add 2 div y0 y1 add 2 div ellipse
closepath
}bdef
/PaintOval{ % x0 y0 x1 y1 graylevel PaintOval --
gsave
5 1 roll
OvalPath
FillPath
grestore
}bdef
/EraseOval{ % x0 y0 x1 y1 EraseOval -- fills with background color
gsave
OvalPath
UseBack fill
grestore
}bdef
/FrameOval{ % x0 y0 x1 y1 FrameOval --
OvalPath
mstroke
}bdef
/RRectPath{ % x0 y0 x1 y1 r OvalPath -- sets current path to rounded rectange, radius r
/radius xdef
/y1 xdef /x1 xdef /y0 xdef /x0 xdef
newpath
x0 radius add y0 M
x1 y0 x1 y1 radius arcto 4{pop}repeat
x1 y1 x0 y1 radius arcto 4{pop}repeat
x0 y1 x0 y0 radius arcto 4{pop}repeat
x0 y0 x1 y0 radius arcto 4{pop}repeat
closepath
}bdef
/PaintRRect{ % x0 y0 x1 y1 r graylevel PaintRRect --
gsave
6 1 roll
RRectPath
FillPath
grestore
}bdef
/EraseRRect{ % x0 y0 x1 y1 r EraseRRect -- fills rect with background color
gsave
RRectPath
UseBack fill
grestore
}bdef
/FrameRRect{ % x0 y0 x1 y1 r FrameRect --
RRectPath
mstroke
}bdef
/CapLine{ % x0 y0 x1 y1 linecap CapLine -- draws line using given line cap
gsave
setlinecap
/y1 xdef /x1 xdef /y0 xdef /x0 xdef
newpath
x0 y0 M
x1 y1 L
mstroke
grestore
}bdef
/Arrow{ % x0 y0 x1 y1 width height graylevel Arrow -- draws arrow at end of line from P0 to P1
gsave
/gl xdef 1 add /aw xdef 1 add /ah xdef /y0 xdef /x0 xdef /y1 xdef /x1 xdef
x0 y0 translate
/x1 x1 x0 sub def
/y1 y1 y0 sub def
y1 x1 atan rotate
newpath
0 0 M
aw ah 2 div L
aw ah 2 div neg L
closepath
gl FillPath
% 10 setmiterlimit
% 1 ps
% 0 StrokePath
grestore
}bdef
% ************ fonts ************
/normal 0 def
/bold 1 def
/italic 2 def
/underline 4 def
/outline 8 def
/shadow 16 def
/FACE1 bold italic or def
/FACE2 outline shadow or def
/Shadow {
gsave
siz 0.08 mul 1 index mul x add
exch siz 0.07 mul mul y add M
c show
grestore
} def
/Outline {
gsave
siz .02 mul setlinewidth
x y M c true charpath
gsave UseBack fill grestore stroke
grestore
} def
/Underline{
gsave
siz 0.08 mul ps
x y clw add M x c stringwidth pop add y clw add L stroke
grestore
}bdef
/DoShow{ % assumes x,y,c are already set
fontkind FACE2 and
dup normal eq {c x y M show} if
dup outline eq {Outline} if
dup shadow eq {1 Shadow Outline} if
outline shadow or eq {1 Shadow 1.5 Shadow Outline} if
fontkind underline and 0 ne { Underline } if
}bdef
/DoWShow{ % assumes x,y,c & w are already set
gsave
x y translate
/x 0 def /y 0 def
w c stringwidth pop div 1 scale
DoShow
grestore
}bdef
/S{
/y xdef /x xdef /c xdef
DoShow
}bdef
/WS{ % string x y desiredwidth WS -
/w xdef /y xdef /x xdef /c xdef
DoWShow
}bdef
/F{
/fontkind xdef
findfont exch /siz xdef [siz 0 0 siz neg 0 0] makefont setfont
}bdef
/Re-encode {
dup length array copy
/eap 0 def
exch {
dup type /integertype eq
{ /eap xdef }
{
1 index
exch
eap exch
put
/eap eap 1 add def
}
ifelse
} forall
} bind def
[ 39/quotesingle 96/grave 128/Adieresis/Aring/Ccedilla/Eacute/Ntilde/Odieresis
/Udieresis/aacute/agrave/acircumflex/adieresis/atilde/aring/ccedilla/eacute
/egrave/ecircumflex/edieresis/iacute/igrave/icircumflex/idieresis/ntilde
/oacute/ograve/ocircumflex/odieresis/otilde/uacute/ugrave/ucircumflex
/udieresis/dagger/degree/cent/sterling/section/bullet/paragraph/germandbls
/registered/copyright/trademark/acute/dieresis/.notdef/AE/Oslash
/.notdef/plusminus/.notdef/.notdef/yen/mu/.notdef/.notdef
/.notdef/.notdef/.notdef/ordfeminine/ordmasculine/.notdef/ae/oslash
/questiondown/exclamdown/logicalnot/.notdef/florin/.notdef/.notdef
/guillemotleft/guillemotright/ellipsis/.notdef/Agrave/Atilde/Otilde/OE/oe
/endash/emdash/quotedblleft/quotedblright/quoteleft/quoteright/divide
/.notdef/ydieresis/Ydieresis/fraction/currency/guilsinglleft/guilsinglright
/fi/fl/daggerdbl/periodcentered/quotesinglbase/quotedblbase/perthousand
/Acircumflex/Ecircumflex/Aacute/Edieresis/Egrave/Iacute/Icircumflex
/Idieresis/Igrave/Oacute/Ocircumflex/.notdef/Ograve/Uacute/Ucircumflex
/Ugrave/dotlessi/circumflex/tilde/macron/breve/dotaccent/ring/cedilla
/hungarumlaut/ogonek/caron]
/zzz xdef
/OurEncoding{ zzz StandardEncoding Re-encode }bdef
/EncodeFont {
findfont
dup length dict begin
{
1 index /FID ne
{ def }
{ pop pop }
ifelse
} forall
/FontName xdef
/Encoding xdef
FontName currentdict
end
definefont pop
} bind def